home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyTokens.p < prev    next >
Encoding:
Text File  |  1994-08-04  |  7.6 KB  |  284 lines  |  [TEXT/PJMM]
  1. unit MyTokens;
  2.  
  3. interface
  4.  
  5.     const { Move to AppGlobals }
  6.         token_strh = 200;
  7.         maxtokenssize_index = 2;
  8.         maxtokens_index = 4;
  9.  
  10.     type
  11.         TokenInterface = object
  12.                 function Read (var count: longInt; data: ptr): OSErr;
  13.                 function Write (count: longInt; data: ptr): OSErr;
  14.             end;
  15.  
  16.     procedure InitTokens;
  17.     procedure FinishTokens;
  18.     procedure ConvertTokens (tob: TokenInterface; space: ptr; space_size: longInt; remoteIP: longInt; crbecomes: str31; user: str63);
  19.  
  20. implementation
  21.  
  22.     uses
  23.         AppGlobals, ParameterDef, MyTranslate82728, MyTrackidle;
  24.  
  25.     const
  26.         cr = 13;
  27.         lf = 10;
  28.         specchar = ord('%');
  29.         fingerd_proc_type = 'PROC';
  30.  
  31.     var
  32.         trans: transTable;
  33.         max_plan_size, max_token_count: longInt;
  34.  
  35.     procedure CallProc (var p: parameterRecord; proc: ptr);
  36.     inline
  37.         $205F, $4E90;
  38.  
  39.     function AddPtr (src: univ Ptr; offset: longint): Ptr;
  40.     inline
  41.         $201F,    { move.l        (sp)+,d0        ; pop offset }
  42.         $D09F,    { add.l            (sp)+,d0        ; add ptr to offset (and pop p) }
  43.         $2E80;    { move.l        d0,(sp)        ; place in result }
  44.  
  45.     procedure AddToPtr (var dst: univ Ptr; src: univ ptr; offset: longint);
  46.     inline
  47.         $201F,    { move.l        (sp)+,d0        ; pop offset }
  48.         $D09F,    { add.l            (sp)+,d0        ; add ptr to offset (and pop p) }
  49.         $205F,    { move.l        (sp)+,a0        ; pop address of p }
  50.         $2080;    { move.l        d0,(sp)        ; place in result }
  51.  
  52.     procedure ConvertTokens (tob: TokenInterface; space: ptr; space_size: longInt; remoteIP: longInt; crbecomes: str31; user: str63);
  53.         var
  54.             retval, paramstr: str255;
  55.             param: parameterRecord;
  56.     begin
  57.         param.fingeredname := @user;
  58.         param.param := @paramstr;
  59.         param.returnValue := @retval;
  60.         param.fingeroutput := space;
  61.         param.plength := space_size;
  62.         param.idle := (TickCount - IdleSince) div 60;
  63.         param.remoteIP := remoteIP;
  64.  
  65.     end;
  66.  
  67.     param.offset;
  68.     param.expandtokens
  69.  
  70.     procedure GetSpecial (p: ptr; var offset: longInt; count: longInt; var name: str63; var paramstr: str255);
  71.         type
  72.             charSet = set of char;
  73.         procedure GetChars (cs: charSet);
  74.             var
  75.                 initoff, len: longInt;
  76.         begin
  77.             initoff := offset;
  78.             while (offset < count) and (chr(AddPtr(p, offset)^) in cs) do
  79.                 offset := offset + 1;
  80.             len := offset - initoff;
  81.             if len > 255 then
  82.                 len := 255;
  83. {$PUSH}
  84. {$R-}
  85.             paramstr[0] := chr(len);
  86.             BlockMove(AddPtr(p, initoff), @paramstr[1], len);
  87. {$POP}
  88.             len := Pos('-', paramstr);
  89.             if len = 0 then begin
  90.                 name := paramstr;
  91.                 paramstr := '';
  92.             end
  93.             else begin
  94.                 name := copy(paramstr, 1, len - 1);
  95.                 paramstr := copy(paramstr, len + 1, 255);
  96.             end;
  97.         end;
  98.     begin
  99.         case chr(AddPtr(p, offset)^) of
  100.             '"':  begin
  101.                 offset := offset + 1;
  102.                 GetChars([' '..'!', '#'..'~']);
  103.                 if chr(AddPtr(p, offset)^) = '"' then
  104.                     offset := offset + 1;
  105.             end;
  106.             '''':  begin
  107.                 offset := offset + 1;
  108.                 GetChars([' '..'&', '('..'~']);
  109.                 if chr(AddPtr(p, offset)^) = '''' then
  110.                     offset := offset + 1;
  111.             end;
  112.             otherwise
  113.                 GetChars(['A'..'Z', 'a'..'z', '0'..'9', '_', '-', ':']);
  114.         end;
  115.     end;
  116.     const
  117.         MyPIn = PIn;
  118.     var
  119.         oe, ooe: OSErr;
  120.         count: longInt;
  121.         refnum: integer;
  122.         hin, hout: handle;
  123.         pin, pout: ptr;
  124.         inoff, outoff, len, newin, i: longInt;
  125.         b: signedByte;
  126.         sysenv: SysEnvRec;
  127.         retval, paramstr: str255;
  128.         th: handle;
  129.         param: parameterRecord;
  130.         proch: handle;
  131.         localhost, charsavailable: longInt;
  132.         remoteport, localport, constate: integer;
  133.         oldvrn: integer;
  134.         oldvrnoe: OSErr;
  135.         tokencount: longInt;
  136. begin
  137.     oldvrnoe := GetVol(nil, oldvrn);
  138.     tokencount := max_token_count;
  139.     oe := MFSOpenDF(refnum, vrn, dirID, name, MyPIn);
  140.     if oe <> noErr then begin
  141.         oe := SysEnvirons(1, sysenv);
  142.         if oe = noErr then
  143.             ooe := SetVol(nil, sysenv.sysVRefNum);
  144.         oe := MFSOpenDF(refnum, sysenv.sysVRefNum, 0, ':Preferences:Plan', MyPIn);
  145.     end
  146.     else begin
  147.         ooe := SysEnvirons(1, sysenv);
  148.         if ooe = noErr then
  149.             ooe := SetVol(nil, sysenv.sysVRefNum);
  150.     end;
  151.     if oe = noErr then begin
  152.         hout := MyTempNewHandle(max_plan_size + 1, oe);
  153.         if oe = noErr then begin
  154.             oe := GetEOF(refnum, count);
  155.             if oe = noErr then
  156.                 hin := MyTempNewHandle(max_plan_size + 1, oe);
  157.             if oe = noErr then begin
  158.                 MyTempHLock(hin, oe);
  159.                 if oe = noErr then
  160.                     MyTempHLock(hout, oe);
  161.                 if count > max_plan_size then
  162.                     count := max_plan_size;
  163.                 if oe = noErr then
  164.                     oe := FSRead(refnum, count, hin^);
  165.                 if oe = noErr then begin
  166.                     param.fingeredName := @user;
  167.                     param.param := @paramstr;
  168.                     param.returnValue := @retval;
  169.                     param.fingeroutput := hout;
  170.                     param.idle := (TickCount - IdleSince) div 60;
  171.                     TCPRawState(tcpc, constate, localhost, localport, param.remoteIP, remoteport, charsavailable);
  172.                     inoff := 0;
  173.                     outoff := 0;
  174.                     pin := hin^;
  175.                     while (outoff <= max_plan_size - 2) and (inoff < count) do begin
  176.                         b := pin^;
  177.                         AddToPtr(pin, pin, 1);
  178.                         inoff := inoff + 1;
  179.                         AddToPtr(pout, hout^, outoff);
  180.                         case b of
  181.                             cr:  begin
  182.                                 pout^ := cr;
  183.                                 AddToPtr(pout, pout, 1);
  184.                                 pout^ := lf;
  185.                                 outoff := outoff + 2;
  186.                             end;
  187.                             lf: 
  188.                                 ;
  189.                             specchar: 
  190.                                 if (pin^ = specchar) or (pin^ = 13) or (tokencount <= 0) then begin
  191.                                     if pin^ <> 13 then begin
  192.                                         pout^ := specchar;
  193.                                         outoff := outoff + 1;
  194.                                     end;
  195.                                     if (pin^ = specchar) or (pin^ = 13) then begin
  196.                                         AddToPtr(pin, pin, 1);
  197.                                         inoff := inoff + 1;
  198.                                     end;
  199.                                 end
  200.                                 else begin
  201.                                     retval := '';
  202.                                     GetSpecial(hin^, inoff, count, name, paramstr);
  203.                                     AddToPtr(pin, hin^, inoff);
  204.                                     proch := GetNamedResource(fingerd_proc_type, name);
  205.                                     if (proch <> nil) & (proch^ <> nil) then begin
  206.                                         tokencount := tokencount - 1;
  207.                                         if max_plan_size - outoff < max_plan_size - count + inoff then
  208.                                             param.hlength := max_plan_size
  209.                                         else
  210.                                             param.hlength := outoff + max_plan_size - count + inoff;
  211.                                         param.offset := outoff;
  212.                                         param.expandtokens := true;
  213.                                         HLock(proch);
  214.                                         CallProc(param, proch^);
  215.                                         HUnlock(proch);
  216.                                         HPurge(proch);
  217.                                         if param.expandtokens then begin
  218.                                             len := param.offset - outoff;
  219.                                             if len > 0 then begin
  220.                                                 if len > max_plan_size - count + inoff then
  221.                                                     len := max_plan_size - count + inoff;
  222.                                                 BlockMove(AddPtr(hin^, inoff), AddPtr(hin^, len), count - inoff);
  223.                                                 BlockMove(AddPtr(hout^, outoff), hin^, len);
  224.                                                 count := len + count - inoff;
  225.                                                 inoff := 0;
  226.                                                 pin := ptr(hin^);
  227.                                             end;
  228.                                         end
  229.                                         else
  230.                                             outoff := param.offset;
  231.                                     end
  232.                                     else
  233.                                         retval := concat('?', name, '?');
  234.                                     AddToPtr(pout, hout^, outoff);
  235.                                     len := length(retval);
  236.                                     if len > param.hlength - outoff then
  237.                                         len := param.hlength - outoff;
  238.                                     if len > 0 then begin
  239.                                         BlockMove(@retval[1], pout, len);
  240.                                         for i := 1 to length(retval) do begin
  241.                                             pout^ := trans[BAND(pout^, $FF)];
  242.                                             longInt(pout) := longInt(pout) + 1;
  243.                                         end;
  244.                                         outoff := outoff + len;
  245.                                     end;
  246.                                 end;
  247.                             otherwise begin
  248.                                 pout^ := trans[BAND(b, $FF)];
  249.                                 outoff := outoff + 1;
  250.                             end;
  251.                         end; {case}
  252.                     end;{while}
  253.                     ooe := TCPSendAsync(tcpc, hout^, outoff, nil);
  254.                 end;
  255.                 MyTempDisposeHandle(hin, ooe);
  256.             end;
  257.             MyTempDisposeHandle(hout, ooe);
  258.         end;
  259.         ooe := FSClose(refnum);
  260.     end;{if open}
  261.     if oe <> noErr then
  262.         NoPlan;
  263.     if oldvrnoe = noErr then
  264.         oe := SetVol(nil, oldvrn);
  265. end;
  266.  
  267. procedure InitTokens;
  268.     var
  269.         s: str255;
  270. begin
  271.     GetIndString(s, tokens_strh, maxplansize_index);
  272.     StringToNum(s, max_tokens_size);
  273.     if max_tokens_size < 1000 then
  274.         max_tokens_size := 1000;
  275.     GetIndString(s, tokens_strh, maxtokens_index);
  276.     StringToNum(s, max_token_count);
  277.     GetTrans(translateOutResID, trans);
  278. end;
  279.  
  280. procedure FinishTokens;
  281. begin
  282. end;
  283.  
  284. end.